


(in-package :gen-res)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun commit-type-slot ( the-subject  the-predicate the-object  )
    (declare (ignorable the-predicate))
  (let*
      (
       ( s (t-elt "pmi" the-subject))
       ( p (t-elt "rdf" "type"))
       ( o (t-elt "pm" the-object ))
       )
    (t-triple s p o)
    )
  )



; !pmi:subject !pm:predicate !_:id
; !_:id !t:time "object"^^Time
(defun commit-time-slot ( the-subject  the-predicate &optional the-object )
    (declare (ignorable the-object))
  (let*
      (
       ( the-id the-subject   )
       ( the-slot-name the-predicate )
       ( blank-node-name (format nil "~a-~a" the-slot-name the-id))
       
       ( s1 (t-elt "pmi" the-id))
       ( p1 (t-elt "pm" the-slot-name))
       ( o1 (blank-node blank-node-name ))
       ( s2 o1 )
       ( p2 (time-predicate) )
       ( o2 (t-time the-object))
       )
    (t-triple s1 p1 o1)
    (t-triple s2 p2 o2)
    )
  )

; !pmi:subject !pm:predicate "object"^^Integer
(defun commit-integer-slot ( the-subject  the-predicate the-object )
  (let*
      (
       ( s (t-elt "pmi" the-subject  ))
       ( p (t-elt "pm" the-predicate ))
       ( o (t-integer the-object) )
       )
    (t-triple s p o)
    )
  )

; !pmi:subject !pm:predicate "object"^^String
(defun commit-string-slot ( the-subject  the-predicate the-object )
  (let*
      (
       ( s (t-elt "pmi" the-subject  ))
       ( p (t-elt "pm" the-predicate ))
       ( o (t-string the-object))
       )
    (t-triple s p o)
    )
  )

(defun commit-done-slot (it the-date)
  
  (commit-string-slot it 'completion-date the-date)
  )

; !pmi:subject !pm:predicate "NA"^^String
(defun commit-nil-slot ( the-subject  the-predicate &optional the-object )
    (declare (ignorable the-object))
  (let*
      (
       ( s (t-elt "pmi" the-subject  ))
       ( p (t-elt "pm" the-predicate ))
       ( o (t-string "NA"))
       )
    (t-triple s p o)
    )
  )


; !pmi:subject !pm:predicate !pmi:object
(defun commit-reference-slot ( the-subject  the-predicate the-object )
    (declare (ignorable the-object))
  (let*
      (
       ( s (t-elt "pmi" the-subject  ))
       ( p (t-elt "pm" the-predicate ))
       ( o (t-elt "pmi" the-object  ))
       )
    (t-triple s p o)
    )
  )


; this is probably what is giving me multiple instances of stuff
(defun do-commit-ref-to-other ( the-subject  the-predicate the-object )
  (let*
      (
       ( the-id (commit-resource-as-list the-object) )
       )
    
    (commit-reference-slot the-subject the-predicate the-id)
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; the sophisticated version
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun do-commit-slot ( s p o)
  
  (if (not o) (commit-nil-slot s p o )
    (if (integerp o) (commit-integer-slot s p o )
      (if (listp o) (do-commit-ref-to-other s p o)
        (let
            (
             (the-time (t-time (string o)))
             )
          (if the-time (commit-time-slot s p o)
            (commit-string-slot s p o)
            )
          )
        )
      )
    )
  )




; the naive version
(defun commit-slot ( the-subject  the-predicate the-object )
  (let*
      (
       ( s (t-elt "pmi" (string the-subject) ))
       ( p (t-elt "pm" (string the-predicate)))
       ( o (if (integerp the-object) 
               (t-integer the-object) (t-string (string the-object))))
       )
    (t-triple s p o)
    )
  )


(defun commit-resource-as-list-02 (the-type the-id ral)
    (commit-type-slot the-id "type" the-type)
    (commit-integer-slot the-id 'ID the-id) ; added 24 Nov to give every resource an explicit ID
    (loop for i from 0 to (- (length ral) 1) by 2 do 
          (let*
              ( 
               ( the-subject the-id )
               ( the-predicate (nth i ral) )
               ( the-object (nth (+ i 1) ral) )
               )
            (if (equal the-predicate 'res) nil
            (do-commit-slot the-subject the-predicate the-object))
            ) ; end let
          ); end loop 
  )



(defun commit-resource-as-list (ral)
  (let*
      (
       (the-id-02 (when (eq (third ral) 'id) (fourth ral)))
       (the-id (if the-id-02 the-id-02 (db.agraph.user::triple-count)))
       (the-type- (when (eq (first ral) 'res) (second ral)))
       (the-type (if the-type- the-type- 'generic-resource))
       )
    (print ral)
    (commit-type-slot the-id "type" the-type)
    (commit-integer-slot the-id 'ID the-id) ; added 24 Nov to give every resource an explicit ID
    (loop for i from 0 to (- (length ral) 1) by 2 do 
          (let*
              ( 
               ( the-subject the-id )
               ( the-predicate (nth i ral) )
               ( the-object (nth (+ i 1) ral) )
               )
            (if (equal the-predicate 'res) nil
            (do-commit-slot the-subject the-predicate the-object))
            ) ; end let
          ); end loop 

   the-id
    
    ) ; end let
  )

(defun commit-all-resources-as-list (ll)
  (mapcar #'commit-resource-as-list ll))

(defmacro caral (l) `(commit-all-resources-as-list ,l))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; resource
(defun commit-resource ( r )
  (let*
      (
       ( s (t-elt "pm" r ))
       ( p (t-elt "rdf" "type"))
       ( o (t-elt "rdfs" "Class"))
       )
    (t-triple s p o)
    )
  )

(defmacro commit-resources-from-list (l)
  `(mapcar #'commit-resource ,l))

;property
(defun commit-property ( p )
  (let*
      (
       ( s (t-elt "pm" p ))
       ( p (t-elt "rdf" "type"))
       ( o (t-elt "rdf" "Property"))
       )
    (t-triple s p o)
    )
  )

(defmacro commit-properties-from-list (l)
  `(mapcar #'commit-property ,l))

;some helper macros
(defmacro listify-property (source target)
  `(defun ,target (l) ( ,source (first l) (second l))))

(defmacro meta-listify-property (source target)
  `(defun ,target (l) (mapcar #',source l)))




; range
(defun commit-property-range( parent child )
  (let*
      (
       ( s (t-elt "pm" parent ))
       ( p (t-elt "rdfs" "range"))
       ( o (t-elt "pm" child))
       )
    (t-triple s p o)
    )
  )

(listify-property commit-property-range commit-property-range-1)
(meta-listify-property commit-property-range-1 commit-property-range-from-list)


; (defun commit-property-range-1 ( l ) ( commit-property-range (first l) (second l)))

;domain
(defun commit-property-domain( parent child )
  (let*
      (
       ( s (t-elt "pm" parent ))
       ( p (t-elt "rdfs" "domain"))
       ( o (t-elt "pm" child))
       )
    (t-triple s p o)
    )
  )


(listify-property commit-property-domain commit-property-domain-1)
(meta-listify-property commit-property-domain-1 commit-property-domain-from-list)


(defun commit-range-and-domain ( range property domain )
  (when range (commit-property-range property range))
  (when domain (commit-property-domain property domain)))


(defun commit-range-and-domain-1 (l) (commit-range-and-domain (first l) (second l) (third l)))

(defmacro commit-range-and-domain-from-list (l)
  `(mapcar #'commit-range-and-domain-1 ,l))

;subclas
(defun commit-subclass ( parent child )
  (let*
      (
       ( s (t-elt "pm" parent ))
       ( p (t-elt "rdfs" "subClassOf"))
       ( o (t-elt "pm" child))
       )
    (t-triple s p o)
    )
  )

(listify-property commit-subclass commit-subclass-1)
(meta-listify-property commit-subclass-1 commit-subclases-from-list)



;;;(defun commit-subclass-1 ( l) ( commit-subclass (first l) (second l)))
;;;
;;;(defmacro commit-subclases-from-list (l)
;;;  `(mapcar #'commit-subclass-1  ,l))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

